Amiga Mag HDD Backup/Amiga Mag HDD Backup.zip/Amiga Mag HDD Backup/Alexander.img.bin/Alexander.img/tech 4.1 editorial Archive.sit/Griebling/Listing2

Text File | 1993-06-16 | 9KB | 336 lines

MODULE Calculator;

FROM Conversions IMPORT ConvStrToNum;
FROM ExNumbers   IMPORT ExNumType, StrToExNum, Ex0, Ex1, pi,
                        e, ExNumb, ExToLongCard, ExDiv, ExMult,
                        ExAdd, ExSub, ExCompare, ExCompareType,
                        ExTrunc, ExChgSign, ExStatus,
                        SetMaxDigits, ExStatusType, ExNumToStr;
FROM InOut       IMPORT WriteString, WriteLn, WriteLongCard;
FROM InOutExt    IMPORT ReadLine;
FROM Strings     IMPORT DeleteSubStr, LocateChar, AssignStr,
                        LocateSubStr, ExtractSubStr, LengthStr;
FROM SYSTEM      IMPORT STRPTR, ADR;


TYPE
  Tokens  = (Empty,

             (* expression tokens *)
             Plus, Minus, Or, Xor, StoreMem,

             (* term tokens *)
             Times, Divide, ShiftLeft, And, Mod, Div,
             ClearBit, SetBit, ToggleBit, AShiftRight,
             RotateRight, RotateLeft, ShiftRight,

             (* power tokens *)
             Power, PercentOf, Root, Squared, Cubed,
             Inverse, Factorial,

             (* miscellaneous tokens *)
             LeftBrace, RightBrace, PowerOfe, Sin, Cos,
             Tan, ArcSin, ArcCos, ArcTan, Sinh, Cosh, Tanh,
             ArcSinh, ArcCosh, ArcTanh, Not, Base, Digits,
             Pi, NaturalLog, SquareRoot, CubeRoot, Decimals,
             Notation, Complement, Log, Number, DegRadGrad,
             MemoryCell);


CONST
  StrSize          = 250;
  Space            = " ";
  NumberChars      = "+-E.0123456789ABCDEF";
  MemoryChars      = "0123456789";
  PunctuationChars = ",'_";

TYPE
  String = ARRAY [0..StrSize] OF CHAR;

VAR
  Token         : Tokens;
  DecPoint      : CARDINAL;
  SciNotation   : BOOLEAN;
  NumberValue   : ExNumType;
  Answer        : ExNumType;
  ResultStr,
  CommandLine   : String;


(*$S-*)
PROCEDURE UnsignInt (Number     : ARRAY OF CHAR;
                     VAR Result : ExNumType);
VAR
  numb  : ExNumType;
  done  : BOOLEAN;
BEGIN
  (* perform the actual conversion from string to number *)
  StrToExNum(Number, numb);
  done := ExStatus = Okay;
  IF done THEN  (* all went OK *)
    Result := numb;
  ELSE
    ExStatus := IllegalNumber;
    Result := Ex0;
  END;
END UnsignInt;


PROCEDURE ExtractNumber(VAR arg         : ARRAY OF CHAR;
                        VAR NumberValue : ExNumType);
VAR
  Constant : String;
  NumChars : ARRAY [0..200] OF CHAR;
  ConIndex : CARDINAL;

  PROCEDURE GetNumber();
  BEGIN
    LOOP
      (* gather number characters *)
      IF LocateChar(NumChars, arg[0], 0) # -1 THEN
        (* not punctuation character *)
        Constant[ConIndex] := arg[0];
        INC(ConIndex);
        DeleteSubStr(arg, 0, 1);
      ELSIF LocateChar(PunctuationChars, arg[0], 0) # -1 THEN
        DeleteSubStr(arg, 0, 1);
      ELSE
        EXIT;
      END;
      IF arg[0] = 0C THEN EXIT END;
    END;
  END GetNumber;

BEGIN
  Constant := "";
  ConIndex := 0;

  (* valid number characters *)
  ExtractSubStr(NumberChars, 0, 14, NumChars);

  (* get a number string from the input *)
  GetNumber();
  Constant[ConIndex] := 0C;  (* terminate the new string *)

  (* convert to an ExNumber *)
  IF ConIndex > 0 THEN
    UnsignInt(Constant, NumberValue);
  ELSE
    NumberValue := Ex0;
    ExStatus := IllegalNumber; (* illegal number or constant *)
  END;
END ExtractNumber;


PROCEDURE GetToken(VAR arg : ARRAY OF CHAR);

CONST
  Sqrd = "\xB2";
  Tims = "\xD7";
  Divd = "\xF7";
  Min1 = "\xAD\xB9";

  PROCEDURE IsToken(Str : ARRAY OF CHAR;
                    T   : Tokens) : BOOLEAN;
  BEGIN
    IF LocateSubStr(arg, Str, 0) = 0 THEN
      DeleteSubStr(arg, 0, LengthStr(Str));
      Token := T;
      RETURN TRUE;
    END;
    RETURN FALSE;
  END IsToken;

BEGIN
  (* delete any blank spaces *)
  WHILE arg[0] = Space DO DeleteSubStr(arg, 0, 1); END;

  (* form a token *)
  IF ((arg[0] >= "0") & (arg[0] <= "9")) OR (arg[0] = ".") THEN
    (* token is some sort of number *)
    Token := Number;
    ExtractNumber(arg, NumberValue);
  ELSIF arg[0] = 0C THEN
    (* empty string *)
    Token := Empty;
  ELSE
    (* token is a symbol *)
    IF IsToken("+",     Plus)        THEN RETURN END;
    IF IsToken("-",     Minus)       THEN RETURN END;
    IF IsToken(Sqrd,    Squared)     THEN RETURN END;
    IF IsToken("x",     Times)       THEN RETURN END;
    IF IsToken(Tims,    Times)       THEN RETURN END;
    IF IsToken("*",     Times)       THEN RETURN END;
    IF IsToken("/",     Divide)      THEN RETURN END;
    IF IsToken(Divd,    Divide)      THEN RETURN END;
    IF IsToken("(",     LeftBrace)   THEN RETURN END;
    IF IsToken(")",     RightBrace)  THEN RETURN END;
    IF IsToken(Min1,    Inverse)     THEN RETURN END;
    IF IsToken("Pi",    Number)      THEN NumberValue := pi;
                                          RETURN END;
    IF IsToken("SCI",   Notation)    THEN RETURN END;
    IF IsToken("DP",    Decimals)    THEN RETURN END;
    IF IsToken("DIG",   Digits)      THEN RETURN END;

    (* Illegal token if we reach here *)
    ExStatus := IllegalOperator;
    DeleteSubStr(arg, 0, 1);
  END;
END GetToken;


PROCEDURE Expression (VAR arg : ARRAY OF CHAR;
                      VAR Result : ExNumType);
  FORWARD;


PROCEDURE Factor (VAR arg : ARRAY OF CHAR;
                  VAR Result : ExNumType);
BEGIN
  CASE Token OF
    LeftBrace :
      GetToken(arg);
      Expression(arg, Result);
      IF Token = RightBrace THEN
        GetToken(arg);
      ELSE
        ExStatus := MismatchBraces;
      END;
      |
    Number :
      GetToken(arg);
      Result := NumberValue;
      |
    Digits :
      GetToken(arg);
      Factor(arg, Result);
      SetMaxDigits(ExToLongCard(Result));
      |
    Decimals :
      GetToken(arg);
      Factor(arg, Result);
      DecPoint := ExToLongCard(Result);
      |
    Notation :
      GetToken(arg);
      SciNotation := NOT SciNotation;
      Result := Ex0;
      |
    ELSE
      ExStatus := IllegalOperator;  (* an illegal factor *)
      Result := Ex0;
  END;
END Factor;


PROCEDURE Powers (VAR arg : ARRAY OF CHAR;
                  VAR Result : ExNumType);
VAR
  temp : ExNumType;
BEGIN
  Factor(arg, temp);
  WHILE (Token >= Power) & (Token <= Factorial) DO
    CASE Token OF
      Squared   : GetToken(arg);
                  ExMult(temp, temp, temp);
                  |
      Inverse   : GetToken(arg);
                  ExDiv(temp, Ex1, temp);
                  |
      ELSE (* do nothing *)
    END;
  END;
  Result := temp;
END Powers;


PROCEDURE Term (VAR arg : ARRAY OF CHAR;
                VAR Result : ExNumType);
VAR
  temp, temp2 : ExNumType;
BEGIN
  Powers(arg, temp);
  WHILE (Token >= Times) & (Token <= ShiftRight) DO
    CASE Token OF
      Times  : GetToken(arg);
               Powers(arg, Result);
               ExMult(temp, Result, temp);
               |
      Divide : GetToken(arg);
               Powers(arg, Result);
               ExDiv(temp, temp, Result);
               |
      ELSE (* do nothing *)
    END;
  END;
  Result := temp;
END Term;


PROCEDURE Expression (VAR arg : ARRAY OF CHAR;
                      VAR Result : ExNumType);
VAR
  temp : ExNumType;
  Str  : String;
BEGIN
  CASE Token OF
    Plus  : GetToken(arg);
            Term(arg, temp);
            |
    Minus : GetToken(arg);
            Term(arg, temp);
            ExChgSign(temp);
            |
    ELSE    Term(arg, temp)
  END;
  WHILE (Token >= Plus) & (Token <= StoreMem) DO
    CASE Token OF
      Plus  : GetToken(arg);
              Term(arg, Result);
              ExAdd(temp, temp, Result);
              |
      Minus : GetToken(arg);
              Term(arg, Result);
              ExSub(temp, temp, Result);
              |
      ELSE    Term(arg, temp);
    END;
  END;
  Result := temp;
END Expression;


PROCEDURE SimpleExpression (VAR arg    : ARRAY OF CHAR;
                            VAR Result : ExNumType);
BEGIN
  ExStatus := Okay;  (* clear out any previous errors       *)
  GetToken(arg);   (* start things off with the first token *)
  Expression(arg, Result);
END SimpleExpression;


BEGIN
  Token := Empty;
  DecPoint := 0;
  SciNotation := FALSE;
  LOOP
    WriteString("Calc> ");
    ReadLine(CommandLine);
    IF LengthStr(CommandLine) = 0 THEN
      EXIT;
    END;
    SimpleExpression(CommandLine, Answer);
    IF SciNotation THEN
      ExNumToStr(Answer, DecPoint, 1, ResultStr);
    ELSE
      ExNumToStr(Answer, DecPoint, 0, ResultStr);
    END;
    IF ExStatus = Okay THEN
      WriteString(ResultStr);
    ELSE
      WriteString("Illegal input string!");
    END;
    WriteLn;
  END;
END Calculator.